home *** CD-ROM | disk | FTP | other *** search
/ Amiga Collections: Nordlicht Spiele / Nordlicht Spiele 04-04 (19xx)(Nordlicht)(DE)(PD).zip / Nordlicht Spiele 04-04 (19xx)(Nordlicht)(DE)(PD).adf / Billard / BillardSound.mod < prev    next >
Text File  |  1992-09-23  |  6KB  |  215 lines

  1. (**********************************************************************
  2.   :Program.    BillardSound.mod
  3.   :Contents.   Sounds for Billard
  4.   :Author.     Stefan Salewski
  5.   :Copyright.  Shareware
  6.   :Language.   Modula-2
  7.   :Translator. M2Amiga AMSoft V3.3d
  8.   :History.    V1.0 1.Dec.1989
  9.   :Address.    Stolper Weg 3, D-2160 Stade
  10. **********************************************************************)
  11.  
  12. IMPLEMENTATION MODULE BillardSound;
  13.   FROM MemSystem IMPORT NoCareAllocMem; (* Autor: Nicolas Benezan *)
  14.   FROM Arts IMPORT Assert,TermProcedure;
  15.   FROM Audio IMPORT IOAudioPtr,IOAudio,audioName,pervol;
  16.   FROM Exec IMPORT DevicePtr,write,OpenDevice,CloseDevice,Byte,
  17.                    MsgPortPtr,IOFlagSet;
  18.   FROM ExecSupport IMPORT CreatePort,DeletePort,BeginIO,AbortIO;
  19.   FROM SYSTEM IMPORT ADR,LONGSET,CAST,ADDRESS;
  20.   FROM RandomNumber IMPORT RND;
  21.  
  22.   CONST
  23.     BallCurveSize0=30;
  24.     BallCurveSize1=30;
  25.     BorderCurveSize=30;
  26.     HoleCurveSize=10;
  27.  
  28.   VAR
  29.     ballCurve0Ptr:POINTER TO ARRAY[0..BallCurveSize0-1] OF Byte;
  30.     ballCurve1Ptr:POINTER TO ARRAY[0..BallCurveSize1-1] OF Byte;
  31.     borderCurvePtr:POINTER TO ARRAY[0..BorderCurveSize-1] OF Byte;
  32.     holeCurvePtr:POINTER TO ARRAY[0..HoleCurveSize-1] OF Byte;
  33.     soundPortPtr:ARRAY[0..3] OF MsgPortPtr;
  34.     devicePtr:DevicePtr;
  35.     allocationMap:ARRAY[0..15] OF Byte;
  36.     ioAudioPtr:ARRAY[0..3] OF IOAudioPtr;
  37.     i:INTEGER;
  38.  
  39.   PROCEDURE OpenAudio():BOOLEAN;
  40.     VAR
  41.       i,j,k:INTEGER;
  42.       unit:ADDRESS;
  43.   BEGIN
  44.     FOR i:=0 TO 3 DO
  45.       soundPortPtr[i]:=CreatePort(ADR("BillardSoundPort"),0);
  46.       Assert(soundPortPtr[i]#NIL,ADR("Can't create Port"));
  47.       NoCareAllocMem(ioAudioPtr[i],SIZE(IOAudio),TRUE);
  48.     END;
  49.     ioAudioPtr[0]^.request.message.node.pri:=-40;
  50.     ioAudioPtr[0]^.request.message.replyPort:=soundPortPtr[0];
  51.     FOR i:=0 TO 15 DO
  52.       allocationMap[i]:=15-i;
  53.     END;
  54.     ioAudioPtr[0]^.data:=ADR(allocationMap);
  55.     ioAudioPtr[0]^.length:=SIZE(allocationMap);
  56.     OpenDevice(ADR(audioName),0,ioAudioPtr[0],LONGSET{});
  57.     IF (ioAudioPtr[0]^.request.error#0) THEN
  58.       RETURN FALSE
  59.     END;
  60.     unit:=ioAudioPtr[0]^.request.unit;
  61.     devicePtr:=ioAudioPtr[0]^.request.device;
  62.     j:=0;
  63.     k:=-1;
  64.     FOR i:=0 TO 3 DO
  65.       WITH ioAudioPtr[i]^ DO
  66.         request.message.replyPort:=soundPortPtr[i];
  67.         request.device:=devicePtr;
  68.         WHILE (j<4) AND NOT(j IN CAST(LONGSET,unit)) DO
  69.           INC(j);
  70.         END;
  71.         IF j<4 THEN
  72.           k:=j;
  73.           request.unit:=CAST(ADDRESS,LONGSET{j});
  74.         ELSIF k>=0 THEN
  75.           request.unit:=CAST(ADDRESS,LONGSET{k});
  76.         ELSE
  77.           request.unit:=NIL; (* LONGSET{} *)
  78.         END;
  79.         INC(j);
  80.         request.command:=write;
  81.         request.flags:=pervol;
  82.         allocKey:=ioAudioPtr[0]^.allocKey;
  83.         period:=0;
  84.         cycles:=0;
  85.         volume:=0;
  86.         data:=NIL;
  87.         length:=0;
  88.       END;
  89.     END;
  90.     RETURN TRUE;
  91.   END OpenAudio;
  92.  
  93.   PROCEDURE InitSounds;
  94.     VAR
  95.       i:INTEGER;
  96.   BEGIN
  97.     NoCareAllocMem(ballCurve0Ptr,BallCurveSize0,TRUE);
  98.     FOR i:=0 TO BallCurveSize0-1 DO
  99.       IF ODD(i) THEN
  100.         ballCurve0Ptr^[BallCurveSize0-1-i]:=i;
  101.       ELSE
  102.         ballCurve0Ptr^[BallCurveSize0-1-i]:=-i;
  103.       END
  104.     END;
  105.     WITH ballSound0Ptr^ DO
  106.       data:=ballCurve0Ptr;
  107.       length:=SIZE(ballCurve0Ptr^);
  108.       period:=2000;
  109.       cycles:=1;
  110.       volume:=64;
  111.     END;
  112.  
  113.     NoCareAllocMem(borderCurvePtr,BorderCurveSize,TRUE);
  114.     FOR i:=0 TO BorderCurveSize-1 DO
  115.       IF ODD(i) THEN
  116.         borderCurvePtr^[BorderCurveSize-1-i]:=i*RND(127 DIV BorderCurveSize)
  117.       ELSE
  118.         borderCurvePtr^[BorderCurveSize-1-i]:=-i*RND(127 DIV BorderCurveSize)
  119.       END
  120.     END;
  121.     WITH borderSoundPtr^ DO
  122.       data:=borderCurvePtr;
  123.       length:=SIZE(borderCurvePtr^);
  124.       period:=2000;
  125.       cycles:=1;
  126.       volume:=64;
  127.     END;
  128.  
  129.     NoCareAllocMem(holeCurvePtr,HoleCurveSize,TRUE);
  130.     FOR i:=0 TO HoleCurveSize-1 DO
  131.       IF ODD(i) THEN
  132.         holeCurvePtr^[HoleCurveSize-1-i]:=i*RND(127 DIV HoleCurveSize);
  133.       ELSE
  134.         holeCurvePtr^[HoleCurveSize-1-i]:=-i*RND(127 DIV HoleCurveSize);
  135.       END
  136.     END;
  137.     WITH holeSoundPtr^ DO
  138.       data:=holeCurvePtr;
  139.       length:=SIZE(holeCurvePtr^);
  140.       period:=24000;
  141.       cycles:=1;
  142.       volume:=64;
  143.     END;
  144.  
  145.     NoCareAllocMem(ballCurve1Ptr,BallCurveSize1,TRUE);
  146.     FOR i:=0 TO BallCurveSize1-1 DO
  147.       IF ODD(i) THEN
  148.         ballCurve1Ptr^[BallCurveSize1-1-i]:=i;
  149.       ELSE
  150.         ballCurve1Ptr^[BallCurveSize1-1-i]:=-i;
  151.       END
  152.     END;
  153.     WITH ballSound1Ptr^ DO
  154.       data:=ballCurve1Ptr;
  155.       length:=SIZE(ballCurve1Ptr^);
  156.       period:=2000;
  157.       cycles:=1;
  158.       volume:=64;
  159.     END;
  160.   END InitSounds;
  161.  
  162.   PROCEDURE Beep(soundPtr:IOAudioPtr;v:Volume);
  163.   BEGIN
  164.     IF soundPtr#NIL THEN
  165.       soundPtr^.volume:=v;
  166.       AbortIO(soundPtr);
  167.       BeginIO(soundPtr);
  168.     END
  169.   END Beep;
  170.  
  171.   PROCEDURE CleanUp();
  172.     VAR i:INTEGER;
  173.   BEGIN
  174.     (*IF CurrentLevel()<=startLevel THEN*)
  175.     IF devicePtr#NIL THEN
  176.        CloseDevice(ioAudioPtr[0]);
  177.       devicePtr:=NIL;
  178.     END;
  179.     FOR i:=0 TO 3 DO
  180.       IF soundPortPtr[i]#NIL THEN
  181.         DeletePort(soundPortPtr[i]);
  182.         soundPortPtr[i]:=NIL;
  183.       END;
  184.     END;
  185.   END CleanUp;
  186.  
  187. BEGIN
  188.   (*startLevel:=CurrentLevel();*)
  189.   devicePtr:=NIL;
  190.   FOR i:=0 TO 3 DO
  191.     soundPortPtr[i]:=NIL;
  192.     ioAudioPtr[i]:=NIL
  193.   END;
  194.   ballSound0Ptr :=NIL;
  195.   ballSound1Ptr :=NIL;
  196.   borderSoundPtr:=NIL;
  197.   holeSoundPtr  :=NIL;
  198.   TermProcedure(CleanUp);
  199.   IF OpenAudio() THEN
  200.     ballSound0Ptr :=ioAudioPtr[0];
  201.     ballSound1Ptr :=ioAudioPtr[1];
  202.     borderSoundPtr:=ioAudioPtr[2];
  203.     holeSoundPtr  :=ioAudioPtr[3];
  204.     InitSounds;
  205.   END;
  206. (*
  207.   Attention: If any error occurs, then some soundPtr can be NIL.
  208.   There is no warning, because we can play Billard without Sound.
  209.   You can allways use Beep(soundPtr), but don't use BeginIO and AbortIO
  210.   with a soundPtr=NIL.
  211. *)
  212. END BillardSound.
  213.  
  214.  
  215.